home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / STRINGS.SWG / 0080_Format Strings.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  5KB  |  107 lines
  1.  
  2. (******************************************************************************
  3.  RealStr.PAS - Routine which formats a double, real or single number to a
  4.                requested number of significant digits.
  5.  Author      - Richard Mullen    CIS 76566,1325
  6.  Date        - 7/5/90, Released to public domain
  7. ******************************************************************************)
  8. {$O+}
  9. {$F+}
  10. {$R+}    { Range checking on               }
  11. {$B-}    { Boolean complete evaluation off }
  12. {$S-}    { Stack checking off              }
  13. {$I-}    { I/O checking off                }
  14. {$V-}    { Relaxed variable checking       }
  15. {$N+}         { Numeric coprocessor             }
  16. {$E+}         { Numeric coprocessor emulation   }
  17.  
  18. UNIT RealStr;
  19.  
  20. INTERFACE
  21.  
  22. function  Real_To_Str  (SigDigits : word; Number : double) : string;
  23.  
  24.                        { SigDigits should be between 2 and 15 for doubles }
  25.                        {                             2 and 11 for reals   }
  26.                        {                             2 and  7 for singles }
  27.  
  28. IMPLEMENTATION
  29.  
  30. (*****************************************************************************)
  31.  
  32. function  Real_To_Str  (SigDigits : word; Number : double) : string;
  33. var
  34.   i             : integer;
  35.   ErrorCode     : integer;
  36.   E_Value       : integer;
  37.   E_Position    : word;
  38.   Exponent      : string[4];
  39.   SDigits       : word;
  40.   TempString    : string;
  41.  
  42. begin
  43. (*
  44.    if SigDigits > 15 then SigDigits := 15;      { 15 for double, 11 for real, }
  45.    if SigDigits < 2 then SigDigits  := 2;       {  7 for single               }
  46. *)
  47.    str (Number, TempString);
  48.    delete (TempString, 3, 1);                        { Delete decimal point   }
  49.    E_Position := pos ('E', TempString);
  50.    val (copy (TempString, E_Position + 1, 5), E_Value, ErrorCode);
  51.    Real_To_Str := '';
  52.    if ErrorCode <> 0 then exit;                      { E_Value = exponent     }
  53.    delete (TempString, E_Position, 6);               { Delete exponent string }
  54.                                                      {  from TempString       }
  55.    if SigDigits + 2 < E_Position then
  56.       begin                                          {  Round TempString      }
  57.       insert ('0', TempString, 2);                   { Insert 0 for overflow  }   E_Position := pos ('E', TempString);
  58.       if TempString[SigDigits + 3] >='5' then                                {}
  59.          inc (TempString[SigDigits + 2]);                                    {}
  60.       for i := SigDigits + 2 downto 2 do                                     {}
  61.          if TempString [i] = chr (ord ('9') + 1) then                        {}
  62.             begin                                                            {}
  63.             TempString [i] := '0';                                           {}
  64.             inc (TempString [i - 1]);                                        {}
  65.             end;                                                             {}
  66.       if TempString[2] = '0' then delete (TempString, 2, 1) { <-- no overflow }
  67.       else inc (E_Value);                                   { <-- overflow    }
  68.       end;                                                                   {}
  69.                                                      { Delete extra precision }
  70.    delete (TempString, SigDigits + 2, length (TempString));
  71.  
  72.    i := length (TempString);                           { Remove all trailing  }
  73.    while (TempString[i] = '0') AND (i > 2) do          {  zeros, leaving only }
  74.       begin                                            {  significant digits  }
  75.       delete (TempString, i, 1);                                             {}
  76.       dec (i);                                                               {}
  77.       end;                                                                   {}
  78.  
  79.    SDigits := length (TempString) - 1;         { Number of significant digits }
  80.  
  81.    if (E_Value >= SigDigits) OR (SDigits - E_Value - 1 > SigDigits) then
  82.       begin                                             { Scientific notation }
  83.       if SDigits > 1 then insert ('.', TempString, 3);                       {}
  84.       str (E_Value, Exponent);                                               {}
  85.       TempString := Tempstring + ' E' + Exponent;                            {}
  86.       end                                                                    {}
  87.    else
  88.       begin
  89.       if E_Value >= 0 then                             { Exponent is positive }
  90.          begin                                         { |Number|, >= 1, can  }
  91.          for i := 1 to E_Value - SDigits + 1 do        {  be displayed with   }
  92.             TempString := TempString + '0';            {  no exponent         }
  93.          if E_Value < SDigits - 1 then insert ('.', TempString, E_Value + 3);
  94.          end
  95.       else
  96.          begin                                         { Exponent is negative }
  97.          for i := 1 to - E_Value - 1 do                { |Number|, < 1,  can  }
  98.             insert ('0', TempString, 2);               {  be displayed with   }
  99.          insert ('0.', TempString, 2);                 {  no exponent         }
  100.          end;                                          { Add '0.' to number   }
  101.       end;
  102.  
  103.    Real_To_Str := TempString;
  104. end;
  105.  
  106. (************************   No initialization   ******************************)
  107. end.